;;; Compiled by f2cl version:
;;; ("$Id: f2cl1.l,v 1.209 2008/09/11 14:59:55 rtoy Exp $"
;;;  "$Id: f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Rel $"
;;;  "$Id: f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Rel $"
;;;  "$Id: f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Rel $"
;;;  "$Id: f2cl5.l,v 1.197 2008/09/11 15:03:25 rtoy Exp $"
;;;  "$Id: f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
;;;  "$Id: macros.l,v 1.106 2008/09/15 15:27:36 rtoy Exp $")

;;; Using Lisp International Allegro CL Enterprise Edition 8.1 [64-bit Linux (x86-64)] (Oct 7, 2008 17:13)
;;;
;;; Options: ((:prune-labels nil) (:auto-save t)
;;;           (:relaxed-array-decls t) (:coerce-assigns :as-needed)
;;;           (:array-type ':array) (:array-slicing t)
;;;           (:declare-common nil) (:float-format double-float))

(in-package :clml.lapack)


(let* ((nbmax 64) (ldt (+ nbmax 1)))
  (declare (type (f2cl-lib:integer4 64 64) nbmax)
   (type (f2cl-lib:integer4) ldt) (ignorable nbmax ldt))
  (defun dormlq (side trans m n k a lda tau c ldc work lwork info)
    (declare (type (array double-float (*)) work c tau a)
     (type (simple-array character (*)) trans side)
     (type (f2cl-lib:integer4) info lwork ldc lda k n m))
    (f2cl-lib:with-multi-array-data ((side character side-%data%
                                      side-%offset%)
                                     (trans character trans-%data%
                                      trans-%offset%)
                                     (a double-float a-%data%
                                      a-%offset%)
                                     (tau double-float tau-%data%
                                      tau-%offset%)
                                     (c double-float c-%data%
                                      c-%offset%)
                                     (work double-float work-%data%
                                      work-%offset%))
      (prog ((i 0) (i1 0) (i2 0) (i3 0) (ib 0) (ic 0) (iinfo 0) (iws 0)
             (jc 0) (ldwork 0) (lwkopt 0) (mi 0) (nb 0) (nbmin 0)
             (ni 0) (nq 0) (nw 0)
             (transt
              (make-array '(1)
                :element-type 'character
                :initial-element #\Space))
             (left nil) (lquery nil) (notran nil)
             (t$
              (make-array (the fixnum (reduce #'* (list ldt nbmax)))
                :element-type 'double-float)))
            (declare (type (array double-float (*)) t$)
             (type (simple-array character (1)) transt)
             (type f2cl-lib:logical left lquery notran)
             (type (f2cl-lib:integer4) i i1 i2 i3 ib ic iinfo iws jc
              ldwork lwkopt mi nb nbmin ni nq nw))
            (setf info 0)
            (setf left (lsame side "L"))
            (setf notran (lsame trans "N"))
            (setf lquery (coerce (= lwork -1) 'f2cl-lib:logical))
            (cond (left (setf nq m) (setf nw n))
                  (t (setf nq n) (setf nw m)))
            (cond ((and (not left) (not (lsame side "R")))
                   (setf info -1))
                  ((and (not notran) (not (lsame trans "T")))
                   (setf info -2))
                  ((< m 0) (setf info -3))
                  ((< n 0) (setf info -4))
                  ((or (< k 0) (> k nq)) (setf info -5))
                  ((< lda
                      (max (the f2cl-lib:integer4 1)
                           (the f2cl-lib:integer4 k)))
                   (setf info -7))
                  ((< ldc
                      (max (the f2cl-lib:integer4 1)
                           (the f2cl-lib:integer4 m)))
                   (setf info -10))
                  ((and (< lwork
                           (max (the f2cl-lib:integer4 1)
                                (the f2cl-lib:integer4 nw)))
                        (not lquery))
                   (setf info -12)))
            (cond ((= info 0)
                   (setf nb
                         (min (the f2cl-lib:integer4 nbmax)
                              (the f2cl-lib:integer4
                                   (ilaenv 1 "DORMLQ"
                                    (f2cl-lib:f2cl-// side trans) m n k
                                    -1))))
                   (setf lwkopt
                         (f2cl-lib:int-mul (max (the f2cl-lib:integer4
                                                     1)
                                                (the f2cl-lib:integer4
                                                     nw))
                                           nb))
                   (setf (f2cl-lib:fref work-%data% (1) ((1 *))
                                        work-%offset%)
                         (coerce (the f2cl-lib:integer4 lwkopt)
                                 'double-float))))
            (cond ((/= info 0)
                   (xerbla "DORMLQ" (f2cl-lib:int-sub info))
                   (go end_label))
                  (lquery (go end_label)))
            (cond ((or (= m 0) (= n 0) (= k 0))
                   (setf (f2cl-lib:fref work-%data% (1) ((1 *))
                                        work-%offset%)
                         (coerce (the f2cl-lib:integer4 1)
                                 'double-float))
                   (go end_label)))
            (setf nbmin 2)
            (setf ldwork nw)
            (cond ((and (> nb 1) (< nb k))
                   (setf iws (f2cl-lib:int-mul nw nb))
                   (cond ((< lwork iws)
                          (setf nb
                                (the f2cl-lib:integer4
                                     (truncate lwork ldwork)))
                          (setf nbmin
                                (max (the f2cl-lib:integer4 2)
                                     (the f2cl-lib:integer4
                                          (ilaenv 2 "DORMLQ"
                                           (f2cl-lib:f2cl-// side
                                                             trans)
                                           m n k -1)))))))
                  (t (setf iws nw)))
            (cond ((or (< nb nbmin) (>= nb k))
                   (multiple-value-bind (var-0 var-1 var-2 var-3 var-4
                                         var-5 var-6 var-7 var-8 var-9
                                         var-10 var-11)
                       (dorml2 side trans m n k a lda tau c ldc work
                        iinfo)
                     (declare
                      (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
                       var-7 var-8 var-9 var-10))
                     (setf iinfo var-11)))
                  (t
                   (cond ((or (and left notran)
                              (and (not left) (not notran)))
                          (setf i1 1)
                          (setf i2 k)
                          (setf i3 nb))
                         (t
                          (setf i1
                                (+ (* (the f2cl-lib:integer4
                                           (truncate (- k 1) nb))
                                      nb)
                                   1))
                          (setf i2 1)
                          (setf i3 (f2cl-lib:int-sub nb))))
                   (cond (left (setf ni n) (setf jc 1))
                         (t (setf mi m) (setf ic 1)))
                   (cond (notran
                          (f2cl-lib:f2cl-set-string transt "T"
                                                    (string 1)))
                         (t
                          (f2cl-lib:f2cl-set-string transt "N"
                                                    (string 1))))
                   (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i i3))
                                 ((> i i2) nil)
                                 (tagbody
                                     (setf ib
                                           (min (the f2cl-lib:integer4
                                                     nb)
                                                (the f2cl-lib:integer4
                                                     (f2cl-lib:int-add (f2cl-lib:int-sub k
                                                                                         i)
                                                                       1))))
                                     (dlarft "Forward" "Rowwise"
                                      (f2cl-lib:int-add (f2cl-lib:int-sub nq
                                                                          i)
                                                        1)
                                      ib
                                      (f2cl-lib:array-slice a
                                                            double-float
                                                            (i i)
                                                            ((1 lda)
                                                             (1 *)))
                                      lda
                                      (f2cl-lib:array-slice tau
                                                            double-float
                                                            (i)
                                                            ((1 *)))
                                      t$ ldt)
                                     (cond (left
                                            (setf mi
                                                  (f2cl-lib:int-add (f2cl-lib:int-sub m
                                                                                      i)
                                                                    1))
                                            (setf ic i))
                                           (t
                                            (setf ni
                                                  (f2cl-lib:int-add (f2cl-lib:int-sub n
                                                                                      i)
                                                                    1))
                                            (setf jc i)))
                                     (dlarfb side transt "Forward"
                                      "Rowwise" mi ni ib
                                      (f2cl-lib:array-slice a
                                                            double-float
                                                            (i i)
                                                            ((1 lda)
                                                             (1 *)))
                                      lda t$ ldt
                                      (f2cl-lib:array-slice c
                                                            double-float
                                                            (ic jc)
                                                            ((1 ldc)
                                                             (1 *)))
                                      ldc work ldwork)
                                   label10))))
            (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
                  (coerce (the f2cl-lib:integer4 lwkopt)
                          'double-float))
            (go end_label)
       end_label (return (values nil nil nil nil nil nil nil nil nil
                                 nil nil nil info))))))

(in-package #-gcl #:cl-user #+gcl "CL-USER")
#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
(eval-when (:load-toplevel :compile-toplevel :execute)
  (setf (gethash 'fortran-to-lisp::dormlq
                 fortran-to-lisp::*f2cl-function-info*)
        (fortran-to-lisp::make-f2cl-finfo :arg-types '((simple-array
                                                        character
                                                        (1))
                                                       (simple-array
                                                        character
                                                        (1))
                                                       (fortran-to-lisp::integer4)
                                                       (fortran-to-lisp::integer4)
                                                       (fortran-to-lisp::integer4)
                                                       (array
                                                        double-float
                                                        (*))
                                                       (fortran-to-lisp::integer4)
                                                       (array
                                                        double-float
                                                        (*))
                                                       (array
                                                        double-float
                                                        (*))
                                                       (fortran-to-lisp::integer4)
                                                       (array
                                                        double-float
                                                        (*))
                                                       (fortran-to-lisp::integer4)
                                                       (fortran-to-lisp::integer4))
          :return-values '(nil nil nil nil nil nil nil nil nil nil nil
                           nil fortran-to-lisp::info)
          :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft
                   fortran-to-lisp::dorml2 fortran-to-lisp::xerbla
                   fortran-to-lisp::ilaenv fortran-to-lisp::lsame))))

